PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Programming/Programming Tools/XCMDs/SendSerial.p

Text File | 1987-08-01 | 5.1 KB | 239 lines | [TEXT/ttxt]

{$R-}
{$D+}
(*
    SendSerial --     a HyperCard user-defined command
                    send bytes out the serial port (at specified baud rate).
                    By Ken D.
    ©Apple Computer, Inc. 1987
    All Rights Reserved.


    example 1:
        SendSerial "Hello There",1200

        sends the string "Hello There" out the modem port at 1200 baud.
        If no baud rate is specified it defaults to 9600.

    example 2:
        SendSerial "AX4500^0D"

        sends the string AX4500<CR> out the modem port at 9600 baud.
        The ^ indicates two hex didgits to follow. (Two ^^ means ^)

    To compile and link this file using Macintosh Programmer's Workshop,

    pascal -w SendSerial.p
    link -m ENTRYPOINT -o HyperCommands -rt XCMD=222 -sn Main=SendSerial ∂
      SendSerial.p.o "{MPW}"Libraries:interface.o

    then use ResEdit to copy the resulting XCMD from Test
    and paste it into HyperCard, the Home stack, or your own stack.
*)

{$S SendSerial }     { Segment name must be the same as the command name. }

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf, HyperXCmd;

PROCEDURE EntryPoint(paramPtr: XCmdPtr);

IMPLEMENTATION

TYPE Str19 = String[19];
     Str31 = String[31];

const debug = false;

PROCEDURE SendSerial(paramPtr: XCmdPtr);                            FORWARD;

   PROCEDURE EntryPoint(paramPtr: XCmdPtr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     SendSerial(paramPtr);
   END;

   PROCEDURE SendSerial(paramPtr: XCmdPtr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
       message, tempStr: Str255;
       refNum: INTEGER;
       err: INTEGER;
       baudRate: INTEGER;

     {$I XCmdGlue.inc }

     PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
     BEGIN
       paramPtr^.returnValue := PasToZero(errMsg);
       EXIT(SendSerial);
     END;

     PROCEDURE OpenSerial;
     VAR handShake: SerShk;
          bRate: INTEGER;
     BEGIN
       { for now, use modem port so we don't mess with AppleTalk }
       bRate := baudRate;
       err := FSOpen('.AOUT',0,refNum);
       IF err = 0 THEN
         BEGIN
           WITH handShake DO
             BEGIN
               fXon := 1;
               fCTS := 1;
               xon  := CHR(17);
               xoff := CHR(19);
               errs := 0;
               evts := 0;
               fInx := 0;
             END;
           err := SerHShake(refNum,handShake);
           IF err = 0 THEN
             err := Control(refNum,13,@bRate);
         END;
        if debug then
            BEGIN
            MoveTo (150,30);
            DrawString('Opened Serial');
            end;
     END;


     PROCEDURE CloseSerial;
     BEGIN
       err := FSClose(refNum);
        if debug then
            BEGIN
            MoveTo (150,90);
            DrawString('closed Serial');
            end;
     END;


     PROCEDURE SendCommand(cmd: Str255);
     VAR count: LongInt;
     BEGIN
        if debug then
            BEGIN
            MoveTo (150,60);
            DrawString('About to FSWrite');
            end;
       count := Length(cmd);
       err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
        if debug then
            BEGIN
            MoveTo (300,60);
            DrawString('FSWrote');
            end;
     END;

     PROCEDURE GetMessage;
     VAR str: STR255;
          charNum: INTEGER;
         msgChar: CHAR;
         commandPtr: Ptr;

         FUNCTION GetHex: CHAR;
             VAR ch: CHAR;
                hex: INTEGER;
         BEGIN
             ch := CHR(commandPtr^);
            IF ch = '^' THEN {two ^'s means really want a ^}
                GetHex := '^'
             ELSE
                BEGIN
                IF (ch >= '0') AND (ch <= '9') THEN
                    hex := ORD(ch) - ORD('0')
                ELSE IF (ch >= 'a') AND (ch <= 'f') THEN
                    hex := 10 + ORD(ch) - ORD('a')
                ELSE IF (ch >= 'A') AND (ch <= 'F') THEN
                    hex := 10 + ORD(ch) - ORD('A')
                ELSE
                    Fail('"^" Must be followed two hex digits (0-9,a-f,A-F)');

                   commandPtr := Pointer(Ord(commandPtr)+1);

                ch := CHR(commandPtr^);
                IF (ch >= '0') AND (ch <= '9') THEN
                    hex := 16*hex + ORD(ch) - ORD('0')
                ELSE IF (ch >= 'a') AND (ch <= 'f') THEN
                    hex := 16*hex + 10 + ORD(ch) - ORD('a')
                ELSE IF (ch >= 'A') AND (ch <= 'F') THEN
                    hex := 16*hex + 10 + ORD(ch) - ORD('A')
                ELSE
                    Fail('"^" Must be followed two hex digits (0-9,a-f,A-F)');

                GetHex := CHR(hex);
                END;
               commandPtr := Pointer(Ord(commandPtr)+1);
         END;

     BEGIN
        WITH paramPtr^ DO
              BEGIN
           { get baud rate if it's there }
            IF paramCount = 2 THEN
              BEGIN
                ZeroToPas(params[2]^,str);
                baudRate := StrToNum(str);
                 if debug then
                    begin
                    moveTo(50,120);
                    drawstring(str);
                    end;
                IF baudRate = 0 THEN
                    Fail('SendSerial cancelled: Zero baud rate specified');
              END;

           { Convert the first parameter into a STR255, processing Hex codes }
           charNum := 0;
           commandPtr := params[1]^;
           WHILE (commandPtr^ <> 0) AND (charNum < 255) DO
             BEGIN
               msgChar := CHR(commandPtr^);
               commandPtr := Pointer(Ord(commandPtr)+1);
               charNum := charNum + 1;
               { If we see a ^ then look for two hex didgits }
               IF msgChar = '^' THEN
                    msgChar := GetHex;
               message[charNum] := msgChar;
             END;

           message[0] := CHR(charNum);
              END; { WITH }

     if debug then
         begin
        moveTo(50,140);
        drawstring(message);
        end;
     END;



   BEGIN {SendSerial}
        baudRate := 9600; { this may get reset in GetMessage }
     GetMessage;

     OpenSerial;
     IF err <> 0 THEN Fail('could not open serial port');

     SendCommand(message);

     CloseSerial;

     if debug then
         begin
        moveTo(50,180);
        drawstring('Finis');
        end;

   END;

END.